home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 44 / 044.d81 / pare a phrase (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  8KB  |  204 lines
  1. 110 diml(4,28),tl(28),vl(26),m(17),sc(4),cl(4),tp(4),n$(4),p$(4)
  2. 120 ln$=""
  3. 130 fp$="[158]                            "
  4. 135 f1$="                            "
  5. 140 f2$="[202][195]name                      "
  6. 145 f3$="[213][195]phrase[195][195]>[195][195]min[195]>[195][201]        "
  7. 150 b1$="[146][155][194]  ":b2$="[155]  [146][194]":re$=" redo                     "
  8. 160 b4$="[155][146][194]                                      [146][194]"
  9. 170 printchr$(147):s=54272:fori=stos+24:pokei,0:next:pokes+24,31
  10. 180 pl=0:poke53280,5:poke53281,5:poke646,0:poke53272,21:printchr$(8)
  11. 190 gosub6050:fori=1to26:readvl(i):next:fori=1to17:readm(i):next
  12. 200 print"[147]number of players (2 to 4)"
  13. 210 print"1 spaces visible"spc(24)"2 spaces concealed"
  14. 220 print"1 one letter revealed per guess"
  15. 230 print"2 all letters of guess revealed"
  16. 240 print"1 chance cards appear at random"
  17. 250 print"2 player asks for a chance card"
  18. 260 print"3 no chance cards"
  19. 270 print"chance cards will alter your score,"
  20. 280 print"grant an extra turn or lose a turn, or"
  21. 285 print"may even reveal a letter. if you choose"
  22. 290 print"'2' above, press f1 to draw a chance"
  23. 300 print"card, which is favorable 55.6% of the   time."
  24. 310 print""tab(4)">";:gosub60500:np=asc(b$)-48:ifnp<2ornp>4then310
  25. 315 printb$
  26. 320 printleft$(ln$,7)tab(4)">";:gosub60500:sp=asc(b$)-49:ifsp<0orsp>1then320
  27. 325 printb$
  28. 330 printleft$(ln$,11)tab(4)">";:gosub60500:lt=asc(b$)-49:iflt<0orlt>1then330
  29. 335 printb$
  30. 340 printleft$(ln$,16)tab(4)">";:gosub60500:rm=asc(b$)-49:ifrm<0orrm>2then340
  31. 345 printb$
  32. 350 ifsp=0thensp$="[146] "
  33. 360 ifspthensp$="[165]"
  34. 370 rem ****initialize screen****
  35. 380 print"[147]";:poke53280,6:poke53281,0:poke53265,peek(53265)and239
  36. 390 print"[146][155][176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"b4$;
  37. 395 print"[145][155] p a r e    a     p h r a s e "
  38. 400 ex=1:f$=f1$:d$=fp$:print"":forpc=1to4:gosub2000:next:printb4$;
  39. 405 print"[145]f1[155] - guess f3[155] - chance card f7[155] - quit";
  40. 410 print"[146][155][173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]";
  41. 415 fora=217to242:pokea,peek(a)or128:next
  42. 420 print"                                       ";
  43. 425 poke2023,160:poke2023+s,6
  44. 430 poke53265,peek(53265)or16:gosub5000:b1$="":b2$=""
  45. 440 forpc=1tonp:n$(pc)="[158]         ":d$=mid$(ln$,26):f$=f2$:ex=0:print"";
  46. 450 gosub2000:gosub3000:n$(pc)=m$:f$=f3$:ex=2
  47. 455 print"";:gosub2000:gosub3000
  48. 460 printleft$(ln$,pc*5+1)spc(6);
  49. 465 fori=1to28:ifi>len(m$)thenprint"[146] ";:goto490
  50. 470 l(pc,i)=tl(i):ifasc(mid$(m$,i,1))=32thenprintsp$;
  51. 480 ifasc(mid$(m$,i,1))<>32thenprint"[155][165]";:cl(pc)=cl(pc)+1
  52. 490 next:p$(pc)=m$
  53. 500 f$=f1$:print"";:gosub2000:gosub6000:next
  54. 600 rem ****main program loop****
  55. 610 pl=int(np*rnd(ti))+1
  56. 620 pl=pl+1-et:ifpl>npthenpl=1:ex=1:et=0
  57. 630 m$="":ir=0:pt=0:et=et-1:ifet<0thenet=0
  58. 640 ifrm=0thengosub7000
  59. 650 g=0:ifcl(1)+cl(2)+cl(3)+cl(4)-cl(pl)=0then1000
  60. 660 pc=pl:print"";:gosub2000:ifpt=1thenpc=pl:print"";:gosub2000:goto620
  61. 670 geta$:ifa$=""then670
  62. 675 ifa$="[136]"thengosub60100:goto670
  63. 680 ifrm<>1then710
  64. 690 ifir=0anda$="[134]"thenir=1:gosub7020
  65. 700 ifpt=1thenpc=pl:print"";:gosub2000:goto620
  66. 710 pq=asc(a$)-48:ifpq<0orpq>nporpq=plthen670
  67. 720 ifpq=0andtp(pl)<2thenpc=pl:print"";:gosub2000:tp(pl)=tp(pl)+1:goto620
  68. 730 ifpq<1thenm$="two consecutive passes only":gosub7180:goto670
  69. 740 ifcl(pq)=0then670
  70. 750 print"[145][145][145]i interrogate "n$(pq)
  71. 755 tp(pl)=0:pc=pq:print"[158]";:gosub2000
  72. 760 geta$:ifa$=""then760
  73. 765 ifa$="[136]"thengosub60100:goto760
  74. 770 k=asc(a$):if(k<64ork>90)andk<>133then760
  75. 780 ifk<>133then810
  76. 790 gosub4000:ifm$=p$(pq)then650
  77. 800 pc=pl:print"";:gosub2000:goto620
  78. 810 print""left$(ln$,pq*5-1)spc(17)chr$(k);:fort=1to500:next
  79. 820 es=len(p$(pq)):n=int(es*rnd(0))+1:ts=0:bs=n:goto850
  80. 830 bs=1:es=n:ts=ts+1:ifts>1andg=0then880
  81. 840 ifts>1andgthen920
  82. 850 ifbs>esthen830
  83. 860 ifl(pq,bs)=kthensc(pl)=sc(pl)+vl(l(pq,bs)-64):g=1:goto900
  84. 870 bs=bs+1:goto850
  85. 880 gosub6120:sc(pl)=sc(pl)-5:sc(pq)=sc(pq)+5:pc=pl:print"";:gosub2000
  86. 890 goto920
  87. 900 cl(pq)=cl(pq)-1:print"[146]"left$(ln$,pq*5+1)spc(5+bs)chr$(l(pq,bs));
  88. 910 gosub6140:l(pq,bs)=32:ifltthen870
  89. 920 pc=pq:print"";:gosub2000:ifgthen650
  90. 930 goto620
  91. 1000 rem ****end of game routine****
  92. 1010 pc=pl:print"":gosub2000
  93. 1020 printleft$(ln$,28)"        g a m e   o v e r         ";
  94. 1030 gosub5000:printleft$(ln$,28)"      play again (y or n) ?    ";
  95. 1040 geta$:ifa$=""then1040
  96. 1050 ifa$="n"then60160
  97. 1060 ifa$<>"y"then1040
  98. 1070 restore
  99. 1080 fori=1to4:cl(i)=0:tp(i)=0:sc(i)=0:n$(i)="":p$(i)="":next:goto150
  100. 2000 rem ****reprint player block****
  101. 2010 f5$=left$(f1$,15-len(n$(pc))-(ex=0)*2)
  102. 2015 f6$=left$(f1$,5-len(str$(sc(pc))))
  103. 2020 printleft$(ln$,(pc*5)-2)b1$" [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201] "b2$;
  104. 2030 printb1$" [194] ";n$(pc)f5$pc"[157] score:"sc(pc)"[157] "f6$" [194] "b2$;
  105. 2040 printb1$" [194] ";f$;" [194] "b2$;
  106. 2050 printb1$" [194] "d$" [194] "b2$;
  107. 2060 printb1$" [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203] "b2$;:return
  108. 3000 rem ****screened input routine****
  109. 3010 poke198,0:y=1:m$="":printleft$(ln$,(pc*5+ex)-1)spc(6)"[158]";:gosub6140
  110. 3020 poke204,0:geta$:ifa$=""then3020
  111. 3025 ifa$<>"[136]"then3030
  112. 3026 poke204,1:poke(peek(209)+peek(210)*256+peek(211)),160:gosub60100:goto3020
  113. 3030 poke204,1:k=asc(a$):ifk=32andtl(y-1)=32ork=32andy=1then3020
  114. 3040 if(k>64andk<91)+(y<29andex>0)+(y<10andex=0)+(k=32)<>-2then3060
  115. 3050 printa$;:tl(y)=k:y=y+1:goto3020
  116. 3060 ifk=20andy>1thenprint" [157][157] [157]";:y=y-1:goto3020
  117. 3070 if(k=13)+(ex>0andy>20)+(ex=0andy>1)=-2thenprint" ";:goto3090
  118. 3080 goto3020
  119. 3090 iftl(y-1)+ex=34thenprintleft$(ln$,pc*5+(ex-1))spc(6)re$;:goto3010
  120. 3100 fori=1toy-1:m$=m$+chr$(tl(i)):next:print"[146]";:return
  121. 3130 pc=pl:print"";:gosub2000:return
  122. 4000 rem ****evaluate phrase guess****
  123. 4010 ifcl(pq)<6then4090
  124. 4020 pc=pq:gosub3000:pc=pl
  125. 4030 ifm$<>p$(pq)thensc(pl)=sc(pl)-100:gosub6100:print"";:goto4090
  126. 4040 fori=1tolen(p$(pq)):ifl(pq,i)=32then4070
  127. 4050 sc(pl)=sc(pl)+vl(l(pq,i)-64):gosub6140
  128. 4055 printleft$(ln$,pq*5+1)spc(5+i);
  129. 4060 print"[146]";chr$(l(pq,i));:print"[156]";:gosub2000
  130. 4070 next
  131. 4080 cl(pq)=0:sc(pl)=sc(pl)+100:print"";:gosub2000:gosub6050
  132. 4090 pc=pq:print"";:gosub2000:return
  133. 5000 rem ****rem game tune****
  134. 5020 pokes+5,0:pokes+6,240:pokes+3,8:pokes+22,128:pokes+23,241
  135. 5030 reada:readb:readc:ifa=-1thenreturn
  136. 5040 pokes,a:pokes+1,b:pokes+4,65:fort=1toc:next:pokes+4,64:goto5030
  137. 6000 rem ****sound effects****
  138. 6010 pokes+5,0:pokes+6,240:fori=1to10step3:pokes,m(i):pokes+1,m(i+1)
  139. 6020 pokes+4,33:fort=1tom(i+2):next:pokes+4,32:next
  140. 6030 if tc<>np then 6040
  141. 6035 pokes,143:pokes+1,10:pokes+4,33:fort=1to400:next:pokes+4,32
  142. 6040 goto6150
  143. 6050 pokes+5,0:pokes+6,240:fori=1to6:onigoto6070,6070,6080,6090,6080,6090
  144. 6060 pokes,lo:pokes+1,hi:pokes+4,33:fort=1tod:next:pokes+4,32:next
  145. 6065 goto6150
  146. 6070 lo=195:hi=16:d=100:goto6060
  147. 6080 lo=31:hi=21:d=100:goto6060
  148. 6090 lo=30:hi=25:d=300:goto6060
  149. 6100 pokes+5,0:pokes+6,240:fori=13to17:pokes,m(i):pokes+1,3:pokes+4,33
  150. 6110 fort=1to250:next:pokes+4,32:next:goto6150
  151. 6120 pokes+5,0:pokes+6,240:pokes,71:pokes+1,6:pokes+4,33
  152. 6130 fort=1to300:next:pokes+4,32:goto6150
  153. 6140 pokes+5,15:pokes+6,249:pokes,151:pokes+1,126:pokes+4,33:pokes+4,32
  154. 6150 return
  155. 7000 rem ****mock error routine****
  156. 7010 ch=int(4*rnd(0))+1:ifch<>plthenm$="":goto7200
  157. 7020 pc=pl:print"[151]";:gosub2000:m=int(9*rnd(0))+1
  158. 7030 onmgoto7040,7050,7060,7070,7080,7090,7100,7110,7150
  159. 7040 m$="scoring glitch  [153]+10 points":sc(pl)=sc(pl)+10:gosub6140:goto7180
  160. 7050 m$="scoring glitch  [153]+20 points":sc(pl)=sc(pl)+20:gosub6140:goto7180
  161. 7060 m$="scoring glitch  [153]